home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / adasmall / test1.ada < prev    next >
Text File  |  1996-01-30  |  5KB  |  190 lines
  1. WITH SMALL_SP;  USE SMALL_SP;
  2.  
  3. PROCEDURE   Test_Pgm   IS
  4.  
  5.   --This is the initial test program for the Small-Ada Compiler
  6.   --   Small-Ada is a restircted subset of the full Ada Language
  7.   --   The Small-Ada compiler was derived from the Co-Pascal
  8.   --       compiler which was in turn was derived from Pascas-S
  9.  
  10.   --Declarations
  11.  
  12.        Ten: CONSTANT INTEGER := 10;     -- Integer    (*  test  *)
  13.        Twenty: CONSTANT  := 20;
  14.        TenpOne: CONSTANT := 10.1;        -- Float
  15.        CCh: CONSTANT   := 'A';          -- Character
  16.        B1, B2: CONSTANT := True;        -- Boolean
  17.  
  18. TYPE   Type1 IS RECORD
  19.                  x: integer;
  20.                  y: Float;
  21.                 END RECORD;
  22. TYPE       Type2 IS String(1..10);
  23. TYPE       Type3 IS Array(1..4) of Type1;
  24. TYPE       Type4 IS RECORD
  25.                  ay: array(1..Ten) of integer;
  26.                 END RECORD;
  27. TYPE       Day IS (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
  28.  
  29.     i1, i2, i3:  integer := 99;
  30.     i4: integer := -i1 + 10;
  31.     i5, i6, i7:  integer;
  32.     r1: Float := 1.23;
  33.     r2: Float := TenpOne;
  34.     c1, c2:  character := '+';
  35.     c3: character := CCh;
  36.     b3, b4, b5:  boolean := false;
  37.     A:  array(1..5) of integer;
  38.     WeekDay: Day;
  39.  
  40. FUNCTION  Add(x, y: integer) RETURN integer IS
  41.   value: integer;
  42.   BEGIN
  43.     value :=  ( x + y );
  44.     RETURN value;
  45.   END Add;
  46.  
  47. PROCEDURE IComp(x, y: integer) IS
  48.   BEGIN
  49.     IF (x <= y) THEN PUT("In "); PUT_LINE("Order");
  50.                 ELSE PUT_LINE("Reverse Order");  END IF;
  51.   END IComp;
  52.  
  53. BEGIN
  54.   --CONSTANT Check
  55.   PUT_LINE("CONSTANT Check");
  56.   PUT("Ten     = ");  PUT_LINE(Ten);
  57.   PUT("Twenty  = ");  PUT_LINE(Twenty);
  58.   PUT("TenpOne = ");  PUT_LINE(TenpOne:10:1);
  59.   PUT("CCh     = ");  PUT_LINE(CCh:5);
  60.   PUT("B1 and B2      = ");  PUT(B1);  PUT_LINE(B2);
  61.  
  62.   --Initialization Check
  63.   PUT_LINE;  PUT_LINE("Initialization Check");
  64.   PUT_LINE("i1 - i3  ", i1, i2, i3);
  65.   PUT_LINE("i4       ", i4);
  66.   PUT_LINE("r1 - r2  ", r1, r2);
  67.   PUT_LINE("c1 - c3  ", c1, c2, c3);
  68.   PUT_LINE("b1 - b5  ", b1, b2, b3, b4, b5);
  69.  
  70.  
  71.   --ARITMNETIC Check
  72.   PUT_LINE;  PUT_LINE("ARITHMETIC Check");
  73.   i1 := 13;             PUT_LINE(i1, " (i1)");
  74.   i2 := Ten;            PUT_LINE(i2, " (i2)");
  75.   i3 := i1 + i2 + 5;    PUT_LINE(i3, " (i3=i1+i2+5)");
  76.   i3 := i1 - Twenty;    PUT_LINE(i1, " (i3=i1-20)");
  77.   i3 := i2 * i1;        PUT_LINE(i2, " (i3=i1*i2)");
  78.   i3 := i1 / 5;         PUT_LINE(i3, " (i3=i1 DIV 5)");
  79.   i3 := i1 MOD 5;       PUT_LINE(i3, " (i3=i1 MOD 5)");
  80.   r1 := 20.4;           PUT_LINE(r1:6:2, " (r1)");
  81.   r2 := r1/2;           PUT_LINE(r2:8:3, " (r1/2)");
  82.   PUT_LINE(10 * tenpone : 10:5, " (10*10.1)");
  83.  
  84.   --LOOP and ARRAY Check
  85.   PUT_LINE;   PUT_LINE("LOOP Check");
  86.   i1 := 10;
  87.   PUT_LINE("Single FOR LOOP 1..5");
  88.   for i IN 1 .. 5 LOOP
  89.      a ( i ) := i * 2;
  90.   END LOOP;
  91.   for n IN 1 .. 5 LOOP
  92.      PUT(n:5, a(n):5);
  93.   END LOOP;
  94.   PUT_LINE;
  95.   PUT_LINE("Double FOR LOOP 1..2 A..E");
  96.   FOR i IN 1 .. 2 LOOP
  97.      PUT("Line: ", i:2);
  98.      for j IN 'A'..'E'  LOOP
  99.         PUT(j:5);
  100.      END LOOP;
  101.      PUT_LINE;
  102.   END LOOP;
  103.   PUT_LINE("Reverse FOR LOOP 1..7");
  104.   FOR i1 IN REVERSE 1..7 LOOP
  105.      PUT(i1:5);
  106.   END LOOP;
  107.   PUT_LINE("  i1 = ", i1:2);
  108.   PUT_LINE;
  109.  
  110.   --WHILE Check
  111.   PUT_LINE;   PUT_LINE("WHILE Check");
  112.   i1 := 0;
  113.   While (i1 < 5) LOOP
  114.       i1 := i1 + 1;
  115.       PUT(i1:2);
  116.   END LOOP;
  117.   PUT_LINE;
  118.  
  119.   --REPEAT Check
  120.   PUT_LINE;   PUT_LINE("REPEAT Check");
  121.   LOOP
  122.     PUT("Rpt  ");
  123.     i1 := i1 + 1;
  124.     Exit WHEN (i1 = Ten);
  125.   END LOOP;
  126.   PUT_LINE;
  127.  
  128.   --Function and Procedure Check
  129.   PUT_LINE;   PUT_LINE("FUNCTION and PROCEDURE Check");
  130.   PUT("compare 10 to 20 ");  IComp(ten, twenty);
  131.   PUT("compare 20 to 10 ");  IComp(twenty, ten);
  132.   PUT(ten:5);  PUT(5:5);  PUT_LINE("     ADD = ", add(ten,5):5);
  133.  
  134.  
  135.   --IF Check
  136.   PUT_LINE;   PUT_LINE("IF and BOOLEAN Check");
  137.   IF ten > twenty THEN
  138.      PUT_LINE(ten, '>', twenty);
  139.   ELSE
  140.      PUT_LINE(ten, '<', twenty);
  141.   END IF;
  142.  
  143.   i1 := 99;
  144.   PUT(i1, " compared to 10 and 20 is :  ");
  145.   IF i1 < 10 THEN
  146.      PUT_LINE("the smallest");
  147.   ELSIF i1 < 20 THEN
  148.      PUT_LINE("in the middle");
  149.   ELSE
  150.      PUT_LINE("the largest");
  151.   END IF;
  152.  
  153.   IF twenty > 10 THEN
  154.      PUT_LINE(twenty, '>', ten);
  155.   END IF;
  156.  
  157.   IF (twenty > ten) AND True THEN
  158.      PUT_LINE("AND OK");
  159.   ELSE
  160.      PUT_LINE("AND not OK");
  161.   END IF;
  162.  
  163.   IF (ten > twenty) OR (Twenty > ten) THEN
  164.      PUT_LINE ("OR OK");
  165.   ELSE
  166.      PUT_LINE ("OR not OK");
  167.   END IF;
  168.  
  169.   IF NOT (ten > twenty) THEN
  170.      PUT_LINE ("NOT OK");
  171.   ELSE
  172.      PUT_LINE ("NOT not OK");
  173.   END IF;
  174.  
  175.   --CASE Check
  176.   PUT_LINE;   PUT_LINE("CASE Check");
  177.   i1 := -1;
  178.   PUT_LINE("Selector value =", i1);
  179.   CASE i1 of
  180.      WHEN    1 | 2    =>    PUT ("Case is 1 or 2 ... ");
  181.                             PUT_LINE("that's OK");
  182.      WHEN    3        =>    PUT_LINE("Case = 3, ");
  183.      WHEN    4        =>    PUT_LINE("Case = 4, ");
  184.      WHEN  OTHERS     =>    PUT ("Case is ");
  185.                             PUT_LINE("Others!");
  186.   END CASE;
  187.  
  188.   PUT_LINE;   PUT_LINE("END OF TEST");
  189.  
  190. END Test_Pgm;